home *** CD-ROM | disk | FTP | other *** search
/ Assassins - Ultimate CD Games Collection 1 / Assassins - Ultimate CD Games Collection (1994)(Weird Science)(Track 1 of 2)[!][Amiga-CD32-CDTV][CDD5332].iso / cards-&-quiz / pontoon / pontoon.amos / pontoon.amosSourceCode < prev   
AMOS Source Code  |  1992-09-02  |  41KB  |  1,244 lines
  1. ' Pontoon by Chris Labrum. Copyright 199O
  2. Set Buffer 20 : Close Workbench : Close Editor : Hide 
  3. Break Off 
  4. DNAME$="" : TITLE$="Title"
  5. Global DNAME$,TITLE$
  6. Screen Open 1,640,256,16,Hires : Flash Off : Curs Off 
  7. On Error Proc HANDLEIT : Auto View Off 
  8. Flash Off : Curs Off : Unpack 1 To 1
  9. CDXSZ=112 : CDYSZ=91 : MAKEAREAX=500 : MAKEAREAY=4
  10. JY=1 : PILE=0 : Dim PILE(52),DPILE(52)
  11. MOSTPLAY=4 : FULLHAND=5 : ACTPLAY=MOSTPLAY : HANDSTART=2
  12. Dim PX(MOSTPLAY,FULLHAND),PY(MOSTPLAY,FULLHAND)
  13. Dim PXP(MOSTPLAY),PYP(MOSTPLAY),PYP2(MOSTPLAY)
  14. Dim ACTHAND(MOSTPLAY,FULLHAND),HAND(MOSTPLAY),FACE(MOSTPLAY),CASH(MOSTPLAY)
  15. Dim CURRENCY$(1) : CURRENCY$(1)="�" : CURRENCY$(0)="$" : CURRENCY=1
  16. THROWOUT=1 : Dim THROW(52) : THROWFACE=0 : THROW=0 : BET=0 : POT=0
  17. PILEX=522 : PILEY=160 : THROWX=PILEX-CDXSZ : THROWY=PILEY
  18. CSPACE=14 : GAPX=2 : GAPY=64
  19. DEALTO=1 : TURN=1 : Dim HANDVAL(MOSTPLAY),HANDVALMAX(MOSTPLAY)
  20. HOLD1=2500-2500 : HOLD2=50000 : HOLD3=10000-10000
  21. Dim PNAME$(MOSTPLAY)
  22. PNAME$(1)="CHRIS" : PNAME$(2)="TOM"
  23. PNAME$(3)="DICK" : PNAME$(4)="HARRY"
  24. MESSX=11 : MESSY=128
  25. PICKUP=0 : Dim PICKUP(MOSTPLAY*FULLHAND)
  26. PICKUPX=THROWX-CDXSZ : PICKUPY=PILEY
  27. WANTIT=0
  28. Dim CARDVAL(52),PCARD(MOSTPLAY,FULLHAND)
  29. N=1 : For A=1 To 52
  30.    CARDVAL(A)=N : If CARDVAL(A)>10 : CARDVAL(A)=10 : End If 
  31.    Inc N : If N>13 : N=1 : End If 
  32. Next A
  33. SHUFFLE=0
  34. Dim INPLAY(MOSTPLAY),WINNER(MOSTPLAY)
  35. WIN=0 : WIN$="" : WIN1$="" : WINNER$=""
  36. ILL$="-: "+Chr$(34)+"I"+Chr$(180)+"ll" : IV$=Chr$(34)
  37. Dim GAMES(MOSTPLAY),USER(MOSTPLAY)
  38. USER(1)=1
  39. For A=1 To MOSTPLAY : FACE(A)=1
  40.    If USER(A)=1 : FACE(A)=0 : End If 
  41. Next A
  42. JSX=300 : JSY=MESSY+64
  43. Restore OPTIONDATA : Read OPTIONS
  44. Dim OPTION$(OPTIONS),OPTION(OPTIONS),OPTSELECT$(OPTIONS,2)
  45. For A=1 To OPTIONS : Read OPTION$(A)
  46.    For B=0 To 1 : Read OPTSELECT$(A,B)
  47. Next B : Next A
  48. OPTION(1)=1
  49. OPTX=240 : OPTY=MESSY+31 : JGUIDE=1 : AUTO=0 : AGAIN=0 : NUMCHANGE=0
  50. STAKE=500 : BETMIN=50 : BETMAX=200 : KITTY=0 : POTX=OPTX+180 : POTY=OPTY+1
  51. BUY=10 : POTSTAY=0 : Dim BROKE(MOSTPLAY)
  52. NOWAIT=0 : NEWGAME=0 : HIGH=0 : LOW=0 : SHUFFLESHOW=1 : BETTER$="" : THEINST=0
  53. ZERO$=""
  54. Global HIGH,LOW,BETTER$,BUY,SHUFFLESHOW,ZERO$
  55. Global BROKE(),NOWAIT,NEWGAME
  56. Global KITTY,POTX,POTY,POTSTAY
  57. Global JGUIDE,AUTO,AGAIN,NUMCHANGE
  58. Global OPTX,OPTY,OPTIONS,OPTION$(),OPTION(),OPTSELECT$()
  59. Global USER(),JSX,JSY
  60. Global WIN,WINNER(),WIN$,WIN1$,WINNER$,ILL$,IV$,GAMES()
  61. Global WANTIT,CARDVAL(),PCARD(),SHUFFLE,INPLAY()
  62. Global PICKUP,PICKUP(),PICKUPX,PICKUPY
  63. Global PNAME$(),MESSX,MESSY
  64. Global HOLD1,HOLD2,HOLD3
  65. Global DEALTO,TURN,HANDVAL(),HANDVALMAX()
  66. Global ACTHAND(),HAND(),FACE(),CASH(),CURRENCY$(),CURRENCY
  67. Global THROWOUT,THROWX,THROWY,THROW,THROW(),THROWFACE
  68. Global BET,POT,BETMIN,BETMAX,STAKE
  69. Global MOSTPLAY,ACTPLAY,PX(),PY(),PXP(),PYP(),PYP2()
  70. Global FULLHAND,CSPACE,GAPX,GAPY
  71. Global HANDSTART,PILEX,PILEY,PILE,PILE(),DPILE()
  72. Global CDXSZ,CDYSZ,MAKEAREAX,MAKEAREAY,JY
  73. MAKECARDS : Palette $80 : CARDPOS : Cls 0
  74. Unpack 2 To 1 : View : Auto View On 
  75. Bell : WFIRE
  76. Cls 0 : NEWPACK
  77. DEMO : FSHUFFLE : INITCASH
  78. For A=1 To MOSTPLAY : INPLAY(A)=1 : Next A
  79. OPTIONLOAD : POTSHOW
  80. Do 
  81.    For TURN=1 To ACTPLAY : INFOSHOW : Next TURN
  82.    CHECKIFBROKE
  83.    For A=1 To ACTPLAY
  84.       If AGAIN=0 and CASH(A)>0
  85.          INPLAY(A)=1
  86.       End If 
  87.    Next A
  88.    MAINDEAL : PILEON
  89.    For TURN=1 To ACTPLAY
  90.       If INPLAY(TURN)=1
  91.          CVALSORT : SAMEKINDACESRIGHT : PICKUPHAND : RESHOWHAND
  92.       End If 
  93.    Next TURN
  94.    Repeat 
  95.       If INPLAY(DEALTO)=0 : DEALTOADD : End If 
  96.    Until INPLAY(DEALTO)=1
  97.    If AGAIN=0 and USER(DEALTO)=1 and INPLAY(DEALTO)=1 : USERBET : End If 
  98.    If AGAIN=0 and USER(DEALTO)=0 : KITTY : End If 
  99.    TURN=DEALTO
  100.    CHECKIFPLAY
  101.    For REPTURN=1 To ACTPLAY
  102.       If INPLAY(TURN)=1 and USER(TURN)=1
  103.          ï¿½SHOWUSERVAL : Repeat 
  104.             WANTIT=-1 : KLRJSTICK : TWISTSTICK : JSTICK1
  105.             Repeat 
  106.                If Fire(JY)=-1
  107.                   WANTIT=0 : Repeat : Until Fire(JY)=0
  108.                End If 
  109.                If Jup(JY)=-1
  110.                   WANTIT=1 : Repeat : Until Jup(JY)=0
  111.                End If 
  112.                If Jdown(JY)=-1 : Repeat : Until Jdown(JY)=0
  113.                   WANTIT=2
  114.                End If 
  115.             Until WANTIT>-1
  116.             KLRJSTICK : CARRYOUT
  117.             CVALSORT : SAMEKINDACESRIGHT : RESHOWHAND : ï¿½SHOWUSERVAL
  118.          Until WANTIT=0 or HAND(TURN)=FULLHAND or HANDVAL(TURN)>21
  119.          KLRJSTICK : ï¿½SHOWSTICK
  120.       End If 
  121.       If INPLAY(TURN)=1 and USER(TURN)=0
  122.          Repeat 
  123.             TWISTSTICK
  124.             CHECKWANTIT
  125.             CARRYOUT
  126.          Until WANTIT=0 or HAND(TURN)=FULLHAND
  127.          ï¿½SHOWSTICK
  128.       End If 
  129.       Inc TURN : If TURN>ACTPLAY : TURN=1 : End If 
  130.    Next REPTURN
  131.    For TURN=1 To ACTPLAY
  132.       If INPLAY(TURN)=1
  133.          CVALSORT : SAMEKINDACESRIGHT
  134.          RVAR=FACE(TURN) : FACE(TURN)=0 : RESHOWHAND : FACE(TURN)=RVAR
  135.          HANDVALUE : ï¿½SHOWUSERVAL
  136.       End If 
  137.    Next TURN
  138.    CHECKWINNER
  139.    KLRMESS
  140.    WINNER$="" : For A=1 To WIN
  141.       WINNER$=WINNER$+PNAME$(WINNER(A))+" And "
  142.    Next A : WINNER$=Left$(WINNER$,Len(WINNER$)-4)
  143.    ZERO$=WIN$ : If Len(ZERO$)<3 : ZERO : End If 
  144.    WINNER$=WINNER$+"Win"+WIN1$+" With "+ZERO$
  145.    If WIN>1 : WINNER$=WINNER$+" And Replay" : End If 
  146.    If WIN>1 and WIN<4 : WINNER$=WINNER$+" For The Pot!" : End If 
  147.    If WIN>0 : Bell : Text MESSX,MESSY,WINNER$ : End If 
  148.    If WIN=1
  149.       Add CASH(WINNER(1)),POT : KITTY=0 : POT=0 : TURN=WINNER(1) : INFOSHOW
  150.       BETTER$="" : BETPOTSHOW : DEALTO=WINNER(1)
  151.    End If 
  152.    POTSTAY=0
  153.    If WIN=0 : POTSTAY=1 : Text MESSX,MESSY,"No Winner... The Pot STAYS!" : End If 
  154.    If AUTO=1 or NOWAIT=1 : Bell : HOLD2 : End If 
  155.    If AUTO=0 : JSTICK3 : End If 
  156.    If AUTO=0 or Fire(JY)=-1
  157.       If AUTO=1 or Fire(JY)=-1 : Bell : NOWAIT=0 : JSTICK3 : NOFIRE : End If 
  158.       If NOWAIT=0
  159.          Do 
  160.             If Fire(JY)=-1 : KLRJSTICK : Exit : End If 
  161.             If Jup(JY)=-1 : KLRJSTICK : OPTIONS : NOFIRE : JSTICK3 : End If 
  162.             If Jleft(JY)=-1 : POTOFF : AUTHOR : POTSHOW : End If 
  163.             If Jright(JY)=-1
  164.                THEINST=1 : KLRJSTICK
  165.                KLRMESS : Text MESSX,MESSY,"Instructions follow......"
  166.                HOLD2: Exit 
  167.             End If 
  168.             If Jdown(JY)=-1 : KLRJSTICK : NEWGAME
  169.                If NEWGAME=0 : JSTICK3 : End If 
  170.                If NEWGAME=1 : Exit : End If 
  171.             End If 
  172.          Loop 
  173.       End If 
  174.    End If 
  175.    KLRJSTICK
  176.    KLRUSERSHOW
  177.    If NEWGAME=0
  178.       PICKEMUP
  179.       If WIN<>1 : DEALTOADD : End If 
  180.       CHECKWHO_OUT
  181.       If AGAIN=0 and POTSTAY=0 and NUMCHANGE>0
  182.          If NUMCHANGE>ACTPLAY
  183.             For TURN=ACTPLAY+1 To NUMCHANGE
  184.                CASH(TURN)=STAKE : INPLAY(TURN)=1 : INFOSHOW
  185.             Next TURN
  186.          End If 
  187.          If NUMCHANGE<ACTPLAY
  188.             For TURN=NUMCHANGE+1 To ACTPLAY
  189.                CASH(TURN)=0 : INPLAY(TURN)=0 : INFOSHOW
  190.             Next TURN
  191.          End If 
  192.          ACTPLAY=NUMCHANGE : DEALTO=1 : NUMCHANGE=0
  193.          KLRMESS : Text MESSX,MESSY,"Number Of Players Changed To"+Str$(ACTPLAY)
  194.          Bell : HOLD2
  195.       End If 
  196.       If SHUFFLE=1 : FSHUFFLE : End If 
  197.    End If 
  198.    NEWGAME=0
  199.    If THEINST=1 : THEINST=0 : THEINSTRUCTIONS : End If 
  200. Loop 
  201. Procedure CHECKIFPLAY
  202.    C=0
  203.    For A=1 To ACTPLAY
  204.       If INPLAY(A)=1 and USER(A)=1
  205.          Inc C
  206.       End If 
  207.    Next A
  208.    NOWAIT=0 : If C=0 : NOWAIT=1 : End If 
  209. End Proc
  210. Procedure CHECKIFBROKE
  211.    For A=1 To ACTPLAY
  212.       If INPLAY(A)=1 and CASH(A)=0 and AGAIN=0 and POTSTAY=0
  213.          INPLAY(A)=0 : BROKE(A)=0
  214.       End If 
  215.    Next A
  216.    C=0 : W=0
  217.    For A=1 To ACTPLAY
  218.       If CASH(A)>0 : Inc C : W=A : End If 
  219.    Next A
  220.    If C=1 and AGAIN=0 and POTSTAY=0
  221.       M$=PNAME$(W)+" Wins This Game !"
  222.       If AUTO=0 : M$=M$+" : PRESS Fire For A NEW GAME" : End If 
  223.       KLRMESS : Text MESSX,MESSY,M$
  224.       Add GAMES(W),1 : Bell 
  225.       If AUTO=0 : WFIRE : End If 
  226.       If AUTO=1 : HOLD2 : End If 
  227.       GAMESHOW
  228.       INITCASH
  229.       For TURN=1 To ACTPLAY : BROKE(TURN)=1 : INPLAY(TURN)=1 : INFOSHOW : Next TURN
  230.       POTOFF : SHUFFLESHOW=1 : FSHUFFLE : POTSHOW : DEALTO=1
  231.    End If 
  232. End Proc
  233. Procedure CHECKWHO_OUT
  234.    AGAIN=0
  235.    If WIN<2
  236.       For A=1 To ACTPLAY
  237.          If CASH(A)>0 and BROKE(A)=1 : INPLAY(A)=1 : End If 
  238.       Next A
  239.    End If 
  240.    If WIN>1
  241.       For A=1 To ACTPLAY : INPLAY(A)=0 : Next A
  242.       For A=1 To WIN : INPLAY(WINNER(A))=1 : Next A
  243.       AGAIN=1
  244.    End If 
  245. End Proc
  246. Procedure HANDLEIT
  247.    KLRMESS
  248.    Text MESSX,MESSY,"PROGRAM ERROR!!!-: Error No."+Str$(Errn)
  249.    Stop 
  250.    WFIRE
  251.    Resume Next 
  252. End Proc
  253. Procedure NEWGAME
  254.    NEWGAME=0
  255.    KLRMESS
  256.    Repeat : Until Jup(JY)=0 and Jdown(JY)=0
  257.    Text MESSX,MESSY,"Joystick UP Confirms NEW GAME : DOWN aborts!"
  258.    Repeat 
  259.       JU=Jup(JY) : JD=Jdown(JY)
  260.    Until JU=-1 or JD=-1
  261.    Repeat : Until Jup(JY)=0 and Jdown(JY)=0
  262.    KLRMESS
  263.    If JU=-1
  264.       If Fire(JY)=-1
  265.          Inc CURRENCY : If CURRENCY>1 : CURRENCY=0 : End If 
  266.          NOFIRE
  267.       End If 
  268.       C=0
  269.       For A=1 To ACTPLAY
  270.          If CASH(A)>C : C=CASH(A) : End If 
  271.       Next A
  272.       M$=""
  273.       S$="" : K=0
  274.       For A=1 To ACTPLAY
  275.          If CASH(A)=C and USER(A)=0 : Inc K : Inc GAMES(A) : M$=M$+PNAME$(A)+" - " : End If 
  276.       Next A
  277.       If K=1 : S$="s" : End If 
  278.       If M$<>"" : M$=M$+"Win"+S$+" This GAME!" : End If 
  279.       Bell : KLRMESS : Text MESSX,MESSY,"NEW GAME Selected : "+M$ : WFIRE
  280.       GAMESHOW : KLRJSTICK : KLRUSERSHOW
  281.       PICKEMUP : POT=0 : AGAIN=0 : POTSTAY=0 : DEALTO=1
  282.       POTSHOW : INITCASH
  283.       For TURN=1 To ACTPLAY
  284.          BROKE(TURN)=1 : INPLAY(TURN)=1 : INFOSHOW
  285.       Next TURN
  286.       Unpack 2 To 1 : WFIRE : Cls 0
  287.       POTOFF : SHUFFLESHOW=1 : FSHUFFLE : POTSHOW : NEWGAME=1
  288.    End If 
  289. End Proc
  290. Procedure GAMESHOW
  291.    M$=""
  292.    For A=1 To MOSTPLAY
  293.       If GAMES(A)>0
  294.          ZERO$=Str$(GAMES(A)) : ZERO
  295.          M$=M$+PNAME$(A)+ZERO$+" "
  296.       End If 
  297.    Next A
  298.    If M$<>""
  299.       KLRMESS : Text MESSX,MESSY,"GAMES WON-: "+M$ : Bell 
  300.       If AUTO=0 : WFIRE : End If 
  301.       If AUTO=1 : HOLD2 : End If 
  302.    End If 
  303. End Proc
  304. Procedure USERBET
  305.    JSTICK2 : KLRMESS : Text MESSX,MESSY,"Make Your Bet "+PNAME$(DEALTO)
  306.    HIGHLOW
  307.    L=(Len(PNAME$(DEALTO))+15)*8
  308.    LO=LOW
  309.    HI=BETMAX
  310.    If LOW>BETMIN : LO=BETMIN : End If 
  311.    If HI>CASH(DEALTO) : HI=CASH(DEALTO) : End If 
  312.    If HI>LOW : HI=LOW : End If 
  313.    KITTY=LO
  314.    Ink 1,11
  315.    Do 
  316.       K$=Str$(KITTY) : K$=Right$(K$,Len(K$)-1)
  317.       ZERO$=K$ : ZERO
  318.       Text POTX+12,POTY+83,"Bet "+CURRENCY$(CURRENCY)+ZERO$+Space$(3-Len(ZERO$))
  319.       If Jup(JY)=-1 and KITTY+10=<HI : Add KITTY,10 : HOLDCURS : End If 
  320.       If Jdown(JY)=-1 and KITTY-10>=LO : Add KITTY,-10 : HOLDCURS : End If 
  321.       If Jleft(JY)=-1 : KITTY=LO : End If 
  322.       If Jright(JY)=-1 : KITTY=HI : End If 
  323.       If Fire(JY)=-1 : NOFIRE : Exit : End If 
  324.    Loop 
  325.    If KITTY>LOW : KITTY=LOW : End If 
  326.    HOLD3
  327.    BETTER$=PNAME$(DEALTO)
  328.    BETSPOTDO
  329.    KLRMESS : KLRJSTICK
  330. End Proc
  331. Procedure KITTY
  332.    KLRMESS : Text MESSX,MESSY,PNAME$(DEALTO)+" Bets ..."
  333.    TURN=DEALTO
  334.    HANDVALUE
  335.    H=HANDVAL(TURN)
  336.    HIGHLOW
  337.    Repeat 
  338.       Randomize Timer : R=Rnd(BETMAX-BETMIN+1)+BETMIN : R$=Right$(Str$(R),1)
  339.    Until R$="0"
  340.    K=0
  341.    If H=200 : K=BETMAX : End If 
  342.    If H>19 : K=BETMAX : End If 
  343.    If H<20 : K=BETMIN : End If 
  344.    If H<6 : K=R : End If 
  345.    If K>LOW : K=LOW : End If 
  346.    If K>BETMAX : K=BETMAX : End If 
  347.    If K>CASH(TURN) : K=CASH(TURN) : End If 
  348.    If LOW=0 : K=0 : End If 
  349.    KITTY=K
  350.    K$=Str$(KITTY) : K$=Right$(K$,Len(K$)-1)
  351.    ZERO$=K$ : ZERO
  352.    Text MESSX,MESSY,PNAME$(DEALTO)+" Bets ..."+CURRENCY$(CURRENCY)+ZERO$
  353.    HOLD3
  354.    BETTER$=PNAME$(DEALTO)
  355.    BETSPOTDO
  356. End Proc
  357. Procedure ZERO
  358.    For ZA=1 To Len(ZERO$)
  359.       If Mid$(ZERO$,ZA,1)="0" : Mid$(ZERO$,ZA,1)="O" : End If 
  360.    Next ZA
  361. End Proc
  362. Procedure BETSPOTDO
  363.    For TURN=1 To ACTPLAY
  364.       If INPLAY(TURN)=1
  365.          Add CASH(TURN),-KITTY : INFOSHOW : Add POT,KITTY
  366.       End If 
  367.    Next TURN
  368.    BETPOTSHOW
  369. End Proc
  370. Procedure HIGHLOW
  371.    LOW=100000 : HIGH=0
  372.    For A=1 To ACTPLAY
  373.       If INPLAY(A)=1 and CASH(A)>HIGH : HIGH=CASH(A) : End If 
  374.       If INPLAY(A)=1 and CASH(A)<LOW : LOW=CASH(A) : End If 
  375.    Next A
  376. End Proc
  377. Procedure POTSHOW
  378.    Put Block 200,POTX,POTY
  379.    Put Block 200,POTX,POTY+30+21
  380.    Put Block 200,POTX,POTY+50+21
  381.    BETPOTSHOW
  382. End Proc
  383. Procedure BETPOTSHOW
  384.    Ink 1,11 : P$=Str$(POT) : P$=Right$(P$,Len(P$)-1)
  385.    K$=Str$(KITTY) : K$=Right$(K$,Len(K$)-1)
  386.    ZERO$=P$ : ZERO
  387.    Text POTX+12,POTY+12,"Pot "+CURRENCY$(CURRENCY)+ZERO$+Space$(4-Len(ZERO$))
  388.    Text POTX+12,POTY+63,BETTER$+Space$(9-Len(BETTER$))
  389.    ZERO$=K$ : ZERO
  390.    Text POTX+12,POTY+83,"Bet "+CURRENCY$(CURRENCY)+ZERO$+Space$(3-Len(ZERO$))
  391. End Proc
  392. Procedure POTOFF
  393.    Ink 0,0 : Bar POTX,POTY To POTX+100,POTY+89
  394. End Proc
  395. Procedure OPTIONSAVE
  396.    SV=0 : KLRMESS
  397.    Text MESSX,MESSY,"Save Options-: Hold DOWN Fire to ABORT Save"
  398.    TT=10 : F=0 : Ink 3,1
  399.    Repeat 
  400.       Text 364,MESSY,Str$(TT)+" "
  401.       For T=1 To 10000 : Next T
  402.       Dec TT
  403.    Until TT=-1 or Fire(JY)=-1
  404.    If Fire(JY)=0
  405.       N=NUMCHANGE : If NUMCHANGE=0 : N=ACTPLAY : End If 
  406.       Show On 
  407.       On Error Goto PERROR1
  408.       Open Out 1,DNAME$+"Options"
  409.       Print #1,N
  410.       For A=1 To 8 : Print #1,OPTION(A) : Next A
  411.       For A=1 To 4 : Print #1,PNAME$(A) : Next A
  412.       Close 1
  413.       KLRMESS : Text MESSX,MESSY,"Options Saved"
  414.       For T=1 To 27000 : Next T
  415.       Goto FINSAVE
  416.       PERROR1:
  417.       KLRMESS : Text MESSX,MESSY,"Options NOT Saved !!!"
  418.       For T=1 To 27000 : Next T
  419.       Resume FINSAVE
  420.       FINSAVE:
  421.       On Error 
  422.    End If 
  423.    KLRMESS : NOFIRE
  424.    Hide On 
  425. End Proc
  426. Procedure OPTIONLOAD
  427.    If Exist(DNAME$+"Options")=-1
  428.       LD=1
  429.       Open In 1,DNAME$+"Options"
  430.       Input #1,ACTPLAY
  431.       For A=1 To 8 : Input #1,OPTION(A) : Next A
  432.       For A=1 To 4 : Input #1,PNAME$(A) : Next A
  433.       Close 1
  434.       KLRMESS : Text MESSX,MESSY,"Options Loaded"
  435.       OPTIONDO
  436.    End If 
  437. End Proc
  438. Procedure OPTIONS
  439.    POTOFF
  440.    KLRMESS : SV=0 : Y=OPTY : X=OPTX
  441.    For A=1 To OPTIONS
  442.       Ink 0,A : Text X,Y,OPTION$(A)
  443.       Ink 0,A : Text X+160,Y,OPTSELECT$(A,OPTION(A))
  444.    Add Y,9 : Next A
  445.    Y=OPTY : N=1
  446.    Do 
  447.       Ink 11,0 : Text X+160,Y,OPTSELECT$(N,OPTION(N))
  448.       For T=1 To 500 : Next T
  449.       Ink 0,N : Text X+160,Y,OPTSELECT$(N,OPTION(N))
  450.       For T=1 To 500 : Next T
  451.       If OPTION(5)=1 : OPTION(5)=0 : USERNAME : NOFIRE : End If 
  452.       If OPTION(9)=1 : OPTION(9)=0 : NUMPLAY : NOFIRE : End If 
  453.       If OPTION(OPTIONS)=1 : OPTION(OPTIONS)=0 : Exit : End If 
  454.       If OPTION(OPTIONS-1)=1 : OPTION(OPTIONS-1)=0 : SV=1 : Exit : End If 
  455.       If Jup(JY)=-1 and N>1 : Dec N : Add Y,-9 : End If 
  456.       If Jdown(JY)=-1 and N<OPTIONS : Inc N : Add Y,9 : End If 
  457.       If Fire(JY)=-1 : WFIRE
  458.          Inc OPTION(N) : If OPTION(N)>1 : OPTION(N)=0 : End If 
  459.       End If 
  460.    Loop 
  461.    OPTIONDO
  462.    KLROPTIONS
  463.    POTSHOW
  464.    If SV=1 : OPTIONSAVE : End If 
  465. End Proc
  466. Procedure OPTIONDO
  467.    C=0
  468.    For A=1 To ACTPLAY
  469.       FACE(A)=1 : USER(A)=OPTION(A)
  470.       If USER(A)=1 : FACE(A)=0 : End If 
  471.       If USER(A)=0 : Inc C : End If 
  472.    Next A
  473.    AUTO=0
  474.    If C=ACTPLAY
  475.       AUTO=1 : KLRMESS
  476.       Text MESSX,MESSY,"AUTOPLAY now ON!: Hold DOWN Fire during game to abort"
  477.    End If 
  478.    SHUFFLE=0 : If OPTION(6)=1 : SHUFFLE=1 : End If 
  479.    JGUIDE=1 : If OPTION(7)=1 : JGUIDE=0 : End If 
  480.    HOLD1=2500 : HOLD3=10000
  481.    If OPTION(8)=1 : HOLD1=0 : HOLD3=0 : End If 
  482. End Proc
  483. Procedure NUMPLAY
  484.    NUMCHANGE=0
  485.    Bell : Ink 3,1 : N=ACTPLAY
  486.    X=OPTX : Y=OPTY-9
  487.    Do 
  488.       Text X,Y,Str$(N)+" Players "
  489.       If Jup(JY)=-1 and N<MOSTPLAY : Inc N : HOLDCURS : End If 
  490.       If Jdown(JY)=-1 and N>2 : Dec N : HOLDCURS : End If 
  491.       If Fire(JY)=-1 : Exit : End If 
  492.    Loop 
  493.    Ink 0,0 : Text X,Y,Space$(12)
  494.    If N<>ACTPLAY
  495.       NUMCHANGE=N : Bell : NOFIRE
  496.    End If 
  497.    If NUMCHANGE=2 and BROKE(3)=0 and BROKE(4)=0 and CASH(1)=0 and CASH(2)=0
  498.       NUMCHANGE=0 : Ink 1,0 : Text X,Y,"Sorry ... Not Available!"
  499.       WFIRE : Ink 0,0 : Text X,Y,Space$(26)
  500.    End If 
  501. End Proc
  502. Procedure USERNAME
  503.    For A=1 To ACTPLAY
  504.       L=1 : X=OPTX : Y=OPTY-10
  505.       XX=X : YY=Y
  506.       X=X+11*8 : N$=Space$(9)
  507.       Ink 1,1
  508.       Text XX,YY,Space$(28)
  509.       Ink 11,1 : Text XX,YY,PNAME$(A) : CH=65
  510.       Bell 
  511.       Do 
  512.          Text X,Y," " : HOLDCURS
  513.          PS=CH : If PS=64 : PS=95 : End If 
  514.          Text X,Y,Chr$(PS) : HOLDCURS
  515.          If Jup(JY)=-1 and CH<90 : Inc CH : End If 
  516.          If Jdown(JY)=-1 and CH>64 : Dec CH : End If 
  517.          If Jright(JY)=-1 and L<9
  518.             Mid$(N$,L)=Chr$(CH) : Inc L : Add X,8
  519.             CH=Asc(Mid$(N$,L)) : If CH=32 : CH=64 : End If 
  520.          End If 
  521.          If Jleft(JY)=-1 and L>1
  522.             Mid$(N$,L)=Chr$(CH) : Dec L : Add X,-8
  523.             CH=Asc(Mid$(N$,L)) : If CH=32 : CH=65 : End If 
  524.          End If 
  525.          If Fire(JY)=-1 : Mid$(N$,L)=Chr$(CH) : Exit : End If 
  526.       Loop 
  527.       For AA=1 To Len(N$)
  528.          If Mid$(N$,AA,1)="@" : Mid$(N$,AA,1)=" " : End If 
  529.       Next AA
  530.       Repeat 
  531.          If Left$(N$,1)=" " : N$=Right$(N$,Len(N$)-1) : End If 
  532.       Until Left$(N$,1)<>" "
  533.       Repeat 
  534.          If Right$(N$,1)=" " : N$=Left$(N$,Len(N$)-1) : End If 
  535.       Until Right$(N$,1)<>" "
  536.       If Len(N$)>1
  537.          PNAME$(A)=N$
  538.          RVAR=TURN : TURN=A : INFOSHOW : TURN=RVAR
  539.       End If 
  540.    Next A
  541.    Ink 0,0 : Bar OPTX,OPTY-20 To OPTX+223,OPTY-8
  542. End Proc
  543. Procedure HOLDCURS
  544.    For T=1 To 900 : Next T
  545. End Proc
  546. Procedure KLROPTIONS
  547.    Ink 0,0 : Bar OPTX,OPTY-7 To OPTX+223,OPTY+100
  548. End Proc
  549. Procedure KLRJSTICK
  550.    Ink 0,0 : Bar JSX-56,JSY-16 To JSX+112,JSY+27
  551. End Proc
  552. Procedure JSTICK1
  553.    If JGUIDE=1
  554.       X=JSX : Y=JSY
  555.       J1$=" TWIST "
  556.       J2$=" STICK "
  557.       J3$="  BUY  "
  558.       J6$="J/Stick"
  559.       J7$="Control"
  560.       Ink 1,13 : Text X,Y-8,J1$
  561.       Ink 1,3 : Text X,Y,J2$
  562.       Ink 1,14 : Text X,Y+8,J3$
  563.       Ink 11,12 : Text X,Y+18,J6$
  564.       Ink 11,12 : Text X,Y+26,J7$
  565.    End If 
  566. End Proc
  567. Procedure JSTICK2
  568.    If JGUIDE=1
  569.       X=JSX : Y=JSY
  570.       J1$="  +1O  "
  571.       J2$="  END  "
  572.       J3$="  -1O  "
  573.       J5$="Minimum"
  574.       J4$="Maximum"
  575.       J6$="J/Stick"
  576.       J7$="Control"
  577.       Ink 1,13 : Text X,Y-8,J1$
  578.       Ink 1,3 : Text X,Y,J2$
  579.       Ink 1,14 : Text X,Y+8,J3$
  580.       Ink 1,14 : Text X+56,Y,J4$
  581.       Ink 1,13 : Text X-56,Y,J5$
  582.       Ink 11,12 : Text X,Y+18,J6$
  583.       Ink 11,12 : Text X,Y+26,J7$
  584.    End If 
  585. End Proc
  586. Procedure JSTICK3
  587.    If JGUIDE=1
  588.       X=JSX : Y=JSY
  589.       J1$="Options"
  590.       J2$=" Cont  "
  591.       J3$="NewGame"
  592.       J4$=" Instr "
  593.       J5$="Author "
  594.       J6$="J/Stick"
  595.       J7$="Control"
  596.       Ink 1,13 : Text X,Y-8,J1$
  597.       Ink 1,3 : Text X,Y,J2$
  598.       Ink 1,14 : Text X,Y+8,J3$
  599.       Ink 1,14 : Text X+56,Y,J4$
  600.       Ink 1,13 : Text X-56,Y,J5$
  601.       Ink 11,12 : Text X,Y+18,J6$
  602.       Ink 11,12 : Text X,Y+26,J7$
  603.    End If 
  604. End Proc
  605. Procedure AUTHOR
  606.    KLRJSTICK
  607.    X=OPTX : Y=OPTY
  608.    Ink 10,10 : Bar X,Y To X+230,Y+90
  609.    Ink 1,10 : Box X,Y To X+230,Y+90
  610.    Ink 9,10 : Bar X+10,Y+10 To X+230-10,Y+90-10
  611.    Ink 1,10 : Box X+10,Y+10 To X+230-10,Y+90-10
  612.    Ink 8,10 : Bar X+20,Y+65 To X+230-20,Y+98-20
  613.    Ink 1,10 : Box X+20,Y+65 To X+230-20,Y+98-20
  614.    Ink 1,9 : Text X+30,Y+20,"Author-: Chris Labrum"
  615.    Ink 11,9 : Text X+21,Y+30,"This program is written"
  616.    Ink 11,9 : Text X+21,Y+39,"entirely in AMOS Basic."
  617.    Ink 12,9 : Text X+21,Y+48,"Thanks to Don and Pat"
  618.    Ink 12,9 : Text X+21,Y+57,"Pearson for testing it!"
  619.    Ink 1,8 : Text X+41,Y+74,"  Copyright 199O"
  620.    WFIRE
  621.    Ink 0,0 : Bar X,Y To X+230,Y+90
  622.    JSTICK3
  623. End Proc
  624. Procedure THEINSTRUCTIONS
  625.    Restore INSTDATA : Cls 1 : Locate 0,1
  626.    Repeat 
  627.       For A=1 To 15
  628.          If D$<>"DONE" : Read D$ : End If 
  629.          If D$<>"DONE" : Print Space$(1);D$ : Print : End If 
  630.       Next A
  631.       Repeat : Until Fire(JY)=-1
  632.       If D$<>"DONE" : Cls 1 : Locate 0,1 : End If 
  633.    Until D$="DONE" or Jup(JY)=-1
  634.    Repeat : Until Jup(JY)=-1
  635.    Cls 0
  636.    POTSHOW
  637. End Proc
  638. Procedure CARRYOUT
  639.    KLRMESS
  640.    If WANTIT=2
  641.       BUY1 : Text MESSX,MESSY,PNAME$(TURN)+ILL$+" BUY One!"+IV$
  642.       RVAR=FACE(TURN)
  643.       If USER(TURN)=0 : FACE(TURN)=1 : End If 
  644.       DEALONE : FACE(TURN)=RVAR
  645.       HOLD1 : HOLD1
  646.    End If 
  647.    If WANTIT=1
  648.       Text MESSX,MESSY,PNAME$(TURN)+ILL$+" Twist!"+IV$
  649.       RVAR=FACE(TURN) : FACE(TURN)=0 : DEALONE : FACE(TURN)=RVAR
  650.       HOLD1: HOLD1
  651.    End If 
  652.    If WANTIT=0
  653.       Text MESSX,MESSY,PNAME$(TURN)+ILL$+" Stick"+IV$
  654.    End If 
  655.    If USER(TURN)=0 : HOLD3 : End If 
  656.    KLRMESS
  657. End Proc
  658. Procedure CHECKWINNER
  659.    For TURN=1 To ACTPLAY
  660.       WINNER(TURN)=0 : HANDVALUE : HANDVALUEMAX
  661.       If HANDVAL(TURN)<15 and HANDVALMAX(TURN)<22
  662.          HANDVAL(TURN)=HANDVALMAX(TURN)
  663.       End If 
  664.    Next TURN
  665.    For A=1 To ACTPLAY
  666.       If INPLAY(A)=0 or HANDVAL(A)<15 : HANDVAL(A)=0 : End If 
  667.       If HANDVAL(A)>21 and HANDVAL(A)<100 : HANDVAL(A)=0 : End If 
  668.    Next A
  669.    WIN$="" : WIN=0 : For A=1 To ACTPLAY
  670.       If HANDVAL(A)=200 : Inc WIN : WINNER(WIN)=A : WIN$="PONTOON" : End If 
  671.    Next A
  672.    If WIN=0
  673.       For A=1 To ACTPLAY
  674.          If HANDVAL(A)=100 : Inc WIN : WINNER(WIN)=A : WIN$="A 5 CARD TRICK" : End If 
  675.       Next A
  676.    End If 
  677.    If WIN=0
  678.       SCORE=21
  679.       Repeat 
  680.          For A=1 To ACTPLAY
  681.             If HANDVAL(A)=SCORE
  682.                Inc WIN : WINNER(WIN)=A : WIN$=Str$(SCORE) : WIN$=Right$(WIN$,Len(WIN$)-1)
  683.             End If 
  684.          Next A : Dec SCORE
  685.       Until WIN>0 or SCORE=14
  686.    End If 
  687.    WIN1$="s"
  688.    If WIN>1
  689.       WIN1$=""
  690.    End If 
  691. End Proc
  692. Procedure TWISTSTICK
  693.    KLRMESS : Text MESSX,MESSY,"Another Card, "+PNAME$(TURN)+"?" : HOLD3
  694. End Proc
  695. Procedure CHECKWANTIT
  696.    HANDVALUE : HANDVALUEMAX
  697.    H=HANDVAL(TURN)
  698.    If H<16 : WANTIT=1 : End If 
  699.    If H>15 : WANTIT=0 : End If 
  700.    If CASH(TURN)>=BUY and H<19 and HAND(TURN)=4 and TURN<ACTPLAY : WANTIT=2 : End If 
  701.    If CASH(TURN)<BUY and H<19 and HAND(TURN)=4 and TURN<ACTPLAY : WANTIT=1 : End If 
  702. End Proc
  703. Procedure BUY1
  704.    Add CASH(TURN),-BUY : INFOSHOW : Add POT,BUY : BETPOTSHOW
  705. End Proc
  706. Procedure PICKUPOFF
  707.    Ink 0 : Bar PICKUPX,PICKUPY To PICKUPX+CDXSZ-1,PICKUPY+CDYSZ-1
  708. End Proc
  709. Procedure PILESHOW
  710.    ZERO$=Str$(PILE) : ZERO
  711.    Ink 1,0 : Text PILEX+28,PILEY-4,"PACK"+ZERO$+Space$(1)
  712. End Proc
  713. Procedure THROWSHOW
  714.    Ink 1,0 : Text THROWX+28,THROWY-4,"PILE"+Str$(THROW)+Space$(1)
  715. End Proc
  716. Procedure KLRMESS
  717.    Ink 0,0 : Text MESSX,MESSY,Space$(80) : Ink 1,0
  718. End Proc
  719. Procedure INITCASH
  720.    For A=1 To ACTPLAY : CASH(A)=STAKE : Next A
  721.    BET=0 : POT=0
  722. End Proc
  723. Procedure INFOSHOW
  724.    Ink 1,0 : Text PXP(TURN),PYP(TURN),PNAME$(TURN)+Space$(9-Len(PNAME$(TURN)))
  725.    Ink 11,0 : C$=Str$(CASH(TURN)) : C$=Right$(C$,Len(C$)-1)
  726.    ZERO$=C$ : ZERO
  727.    Text PXP(TURN)+80,PYP(TURN),"CASH "+CURRENCY$(CURRENCY)+ZERO$+Space$(6-Len(ZERO$))
  728. End Proc
  729. Procedure ï¿½SHOWSTICK
  730.    Ink 0,0 : Text PXP(TURN),PYP2(TURN),Space$(17)
  731.    Ink 1,3 : Text PXP(TURN),PYP2(TURN)," STICK "
  732. End Proc
  733. Procedure ï¿½SHOWUSERVAL
  734.    HANDVALUE : HANDVALUEMAX
  735.    H=HANDVAL(TURN) : H2=HANDVALMAX(TURN)
  736.    B=H
  737.    If H2<22 : B=H2 : End If 
  738.    B$=Str$(B) : If B>21 : B$=" BUST!" : End If 
  739.    If H=100 : B$=" 5 CARD TRICK" : End If 
  740.    If H=200 : B$=" PONTOON" : End If 
  741.    Ink 0,0 : Text PXP(TURN),PYP2(TURN),Space$(17)
  742.    ZERO$=B$ : If Len(B$)<4 : ZERO : End If 
  743.    Ink 3,1 : Text PXP(TURN),PYP2(TURN),ZERO$+" "
  744. End Proc
  745. Procedure KLRUSERSHOW
  746.    Ink 0,0
  747.    For A=1 To ACTPLAY : Text PXP(A),PYP2(A),Space$(19) : Next A
  748. End Proc
  749. Procedure HANDVALUE
  750.    HANDVAL(TURN)=0
  751.    For B=1 To HAND(TURN)
  752.       Add HANDVAL(TURN),PCARD(TURN,B)
  753.    Next B
  754.    If HAND(TURN)=2
  755.       If PCARD(TURN,1)=1 and PCARD(TURN,2)=10 : HANDVAL(TURN)=200 : End If 
  756.       If PCARD(TURN,2)=1 and PCARD(TURN,1)=10 : HANDVAL(TURN)=200 : End If 
  757.    End If 
  758.    If HAND(TURN)=5 and HANDVAL(TURN)<22
  759.       HANDVAL(TURN)=100
  760.    End If 
  761. End Proc
  762. Procedure HANDVALUEMAX
  763.    HANDVALUE : HANDVALMAX(TURN)=HANDVAL(TURN)
  764.    For B=1 To HAND(TURN)
  765.       If HANDVALMAX(TURN)+10<22
  766.          If PCARD(TURN,B)=1
  767.             Add HANDVALMAX(TURN),10
  768.          End If 
  769.       End If 
  770.    Next B
  771. End Proc
  772. Procedure HANGON
  773.    For T=1 To 500 : Next T
  774. End Proc
  775. Procedure PICKUPHAND
  776.    For B=HAND(TURN) To 1 Step -1
  777.       Ink 0 : Bar PX(TURN,B),PY(TURN,B) To PX(TURN,B)+CDXSZ-1,PY(TURN,B)+CDYSZ-1
  778.       If B>1 and FACE(TURN)=0 : Put Block ACTHAND(TURN,B-1),PX(TURN,B-1),PY(TURN,B-1) : End If 
  779.       If B>1 and FACE(TURN)=1 : Put Block 53,PX(TURN,B-1),PY(TURN,B-1) : End If 
  780.    Next B
  781. End Proc
  782. Procedure RESHOWHAND
  783.    For A=1 To HAND(TURN)
  784.       If FACE(TURN)=0 : Put Block ACTHAND(TURN,A),PX(TURN,A),PY(TURN,A) : End If 
  785.       If FACE(TURN)=1 : Put Block 53,PX(TURN,A),PY(TURN,A) : End If 
  786.    Next A
  787. End Proc
  788. Procedure CVALSORT
  789.    For A=1 To HAND(TURN) : DPILE(A)=ACTHAND(TURN,A) : Next A
  790.    N=1
  791.    For A=1 To 13
  792.       For B=1 To HAND(TURN) : V=DPILE(B)
  793.          If V=A or V=A+13 or V=A+26 or V=A+39
  794.             If N<=HAND(TURN) : ACTHAND(TURN,N)=V : DPILE(B)=0 : Inc N : End If 
  795.          End If 
  796.       Next B
  797.    Next A
  798.    HOLD1
  799. End Proc
  800. Procedure SAMEKINDACESRIGHT
  801.    For A=1 To HAND(TURN) : C=ACTHAND(TURN,1)
  802.       If C=1 or C=14 or C=27 or C=40
  803.          For B=1 To HAND(TURN)-1
  804.             ACTHAND(TURN,B)=ACTHAND(TURN,B+1)
  805.          Next B
  806.          ACTHAND(TURN,HAND(TURN))=C
  807.       End If 
  808.    Next A
  809. End Proc
  810. Procedure CSUITSORT
  811.    For A=1 To HAND(TURN) : DPILE(A)=ACTHAND(TURN,A) : Next A
  812.    N=1
  813.    For A=1 To 52
  814.       For B=1 To HAND(TURN) : V=DPILE(B)
  815.          If V=A
  816.             If N<=HAND(TURN) : ACTHAND(TURN,N)=V : DPILE(B)=0 : Inc N : End If 
  817.          End If 
  818.       Next B
  819.    Next A
  820.    HOLD1
  821. End Proc
  822. Procedure SUITACESRIGHT
  823.    N=1
  824.    Repeat 
  825.       For A=1 To HAND(TURN)
  826.          If ACTHAND(TURN,A)=N
  827.             If A<HAND(TURN)
  828.                If ACTHAND(TURN,A+1)>N and ACTHAND(TURN,A+1)<N+13
  829.                   Swap ACTHAND(TURN,A),ACTHAND(TURN,A+1)
  830.                End If 
  831.             End If 
  832.          End If 
  833.       Next A
  834.       Add N,13
  835.    Until N>40
  836. End Proc
  837. Procedure DEALTOADD
  838.    Inc DEALTO : If DEALTO>ACTPLAY : DEALTO=1 : End If 
  839. End Proc
  840. Procedure DEALONE
  841.    PLUP : N=TURN : Inc HAND(N) : B=HAND(N)
  842.    If FACE(N)=0 : Put Block PILE(PILE),PX(N,B),PY(N,B) : End If 
  843.    If FACE(N)=1 : Put Block 53,PX(N,B),PY(N,B) : End If 
  844.    ACTHAND(N,B)=PILE(PILE) : PCARD(N,B)=CARDVAL(PILE(PILE))
  845.    Dec PILE : PILESHOW
  846.    HOLD1
  847. End Proc
  848. Procedure PLUP
  849.    Play 1,30,0
  850. End Proc
  851. Procedure MAINDEAL
  852.    KLRMESS : Ink 1,0 : Text MESSX,MESSY,"Main Deal..."
  853.    N=DEALTO
  854.    For A=1 To ACTPLAY : HAND(A)=0 : Next A
  855.    For B=1 To HANDSTART
  856.       For A=1 To ACTPLAY
  857.          If INPLAY(N)=1
  858.             PLUP
  859.             If FACE(N)=0 : Put Block PILE(PILE),PX(N,B),PY(N,B) : End If 
  860.             If FACE(N)=1 : Put Block 53,PX(N,B),PY(N,B) : End If 
  861.             ACTHAND(N,B)=PILE(PILE) : PCARD(N,B)=CARDVAL(PILE(PILE))
  862.             Dec PILE : PILESHOW
  863.          End If 
  864.          Inc N : If N>ACTPLAY : N=1 : End If 
  865.          HOLD1
  866.       Next A
  867.    Next B
  868.    For A=1 To ACTPLAY : If INPLAY(A)=1 : HAND(A)=HANDSTART : End If : Next A
  869.    KLRMESS
  870. End Proc
  871. Procedure PICKEMUP
  872.    KLRMESS : Ink 1,0 : Text MESSX,MESSY,"Collecting Cards"
  873.    PICKUP=0 : A=1
  874.    For AA=1 To ACTPLAY
  875.       For B=HAND(A) To 1 Step -1
  876.          If INPLAY(A)=1
  877.             Ink 0 : Bar PX(A,B),PY(A,B) To PX(A,B)+CDXSZ-1,PY(A,B)+CDYSZ-1
  878.             If B>1 : Put Block ACTHAND(A,B-1),PX(A,B-1),PY(A,B-1) : End If 
  879.             Inc PICKUP : PICKUP(PICKUP)=ACTHAND(A,B)
  880.             Put Block PICKUP(PICKUP),PICKUPX,PICKUPY
  881.             Dec HAND(A)
  882.          End If 
  883.       HOLD1 : Next B
  884.       Inc A : If A>ACTPLAY : A=1 : End If 
  885.    Next AA : HOLD3
  886.    KLRMESS : Ink 1,0 : Text MESSX,MESSY,"Cards To Bottom Of Pack"
  887.    CARDSTOBOTTOM
  888. End Proc
  889. Procedure CARDSTOBOTTOM
  890.    C=PICKUP
  891.    For A=1 To PICKUP
  892.       For B=52 To 2 Step -1
  893.          PILE(B)=PILE(B-1)
  894.       Next B
  895.       PILE(1)=PICKUP(A) : Dec C
  896.       If C>1 : Put Block PICKUP(C-1),PICKUPX,PICKUPY : End If 
  897.       Inc PILE : PILESHOW
  898.    Next A
  899.    KLRMESS
  900.    PICKUP=0
  901.    PICKUPOFF
  902. End Proc
  903. Procedure HOLD1
  904.    For T=1 To HOLD1 : Next T
  905. End Proc
  906. Procedure HOLD2
  907.    For T=1 To HOLD2 : Next T
  908. End Proc
  909. Procedure HOLD3
  910.    For T=1 To HOLD3 : Next T
  911. End Proc
  912. Procedure PILEON
  913.    Put Block 53,PILEX,PILEY
  914. End Proc
  915. Procedure PILEOFF
  916.    Ink 0 : Bar PILEX,PILEY To PILEX+CDXSZ-1,PILEY+CDYSZ-1
  917. End Proc
  918. Procedure CARDPOS
  919.    Cls 0 : X=14 : PY=160 : CD=1
  920.    For A=1 To ACTPLAY : N=1
  921.       For XX=X To X+(FULLHAND-1)*CSPACE Step CSPACE
  922.          'Put Block CD,XX,PY
  923.          PX(A,N)=XX : PY(A,N)=PY
  924.          Inc CD : Inc N
  925.       Next XX
  926.       PXP(A)=X : PYP(A)=PY+CDYSZ+8
  927.       PYP2(A)=PY+CDYSZ+17
  928.       If A=1 : PYP(A)=PY-3 : PYP2(A)=PY-13 : End If 
  929.       X=XX+CDXSZ+GAPX
  930.       If A=1
  931.          X=14
  932.          Add PY,-(CDYSZ+GAPY)
  933.       End If 
  934.    Next A
  935. End Proc
  936. Procedure WFIRE
  937.    Repeat : Until Fire(JY)=-1
  938.    Repeat : Until Fire(JY)=0
  939. End Proc
  940. Procedure NOFIRE
  941.    Repeat : Until Fire(JY)=0
  942. End Proc
  943. Procedure PSHUFFLE
  944. End Proc
  945. Procedure SHUFFLER
  946.    Shared HOLD1
  947.    PILEOFF
  948.    X=10 : YY=130
  949.    If SHUFFLESHOW=1
  950.       POTOFF
  951.       For A=1 To 52
  952.          Put Block PILE(A),X,PILEY
  953.          Add X,10
  954.       Next A : Add X,-10 : HOLD1
  955.       Repeat : Until Fire(JY)=0
  956.       For A=1 To 52
  957.          Put Block 53,X,PILEY
  958.          Add X,-10
  959.       Next A : Add X,10 : Ink 0,0 : HOLD1
  960.       For A=1 To 52
  961.          Bar X,PILEY To X+CDXSZ-1,PILEY+CDYSZ-1
  962.          If A<52 : Put Block 53,X+10,PILEY : End If 
  963.          Add X,10
  964.       Next A : HOLD1
  965.    End If 
  966.    For REP=1 To 3
  967.       For A=1 To 52
  968.          X=Rnd(10) : Y=Rnd(6)
  969.          Put Block 53,260+X,YY+Y
  970.       Next A
  971.       Ink 0,0 : Bar 260,YY To 260+CDXSZ+20,YY+CDYSZ+10
  972.       Put Block 53,260,YY : HOLD3
  973.    Next REP
  974.    Bar 260,YY To 260+CDXSZ+20,YY+CDYSZ+10
  975.    SHUFFLESHOW=0
  976. End Proc
  977. Procedure FSHUFFLE
  978.    PILEOFF : KLRMESS : Ink 1,0 : Text MESSX,MESSY,"Shuffling Pack"
  979.    SHUFFLER
  980.    NEWPACK
  981.    For A=1 To 52 : DPILE(A)=PILE(A) : PILE(A)=0 : Next A
  982.    A=1
  983.    Repeat 
  984.       Randomize Timer : R=Rnd(51)+1
  985.       If DPILE(R)>0 : PILE(A)=DPILE(R) : DPILE(R)=0 : Inc A : End If 
  986.    Until A=53
  987.    KLRMESS : PILE=52 : PILEON : PILESHOW : POTSHOW
  988. End Proc
  989. Procedure NEWPACK
  990.    For A=1 To 52 : PILE(A)=A : Next A : PILE=52
  991. End Proc
  992. Procedure CARDPARTS
  993.    Screen Open 1,640,256,16,Hires
  994.    Flash Off : Curs Off 
  995.    Load Iff "DF0:Pics/CardParts"
  996.    Get Palette 1
  997. End Proc
  998. Procedure JACK
  999.    Get Block 59,36+16,4+CDYSZ+2+8,CDXSZ-34,CDYSZ-16
  1000.    Put Block 59,MAKEAREAX+15,MAKEAREAY+8
  1001.    Del Block 59
  1002. End Proc
  1003. Procedure QUEEN
  1004.    Get Block 59,36+16+CDXSZ*1+2,4+CDYSZ+2+8,CDXSZ-34,CDYSZ-16
  1005.    Put Block 59,MAKEAREAX+15,MAKEAREAY+8
  1006.    Del Block 59
  1007. End Proc
  1008. Procedure KING
  1009.    Get Block 59,(36+CDXSZ*3+3)+21,11,CDXSZ-34,CDYSZ-16
  1010.    Put Block 59,MAKEAREAX+15,MAKEAREAY+8
  1011.    Del Block 59
  1012. End Proc
  1013. Procedure BLUEBACK
  1014.    Get Block 53,36+CDXSZ*1+3,4,CDXSZ,CDYSZ
  1015. End Proc
  1016. Procedure REDBACK
  1017.    Get Block 53,36+CDXSZ*2+6,4,CDXSZ,CDYSZ
  1018. End Proc
  1019. Procedure MAKECARDS
  1020.    Get Block 200,521,26,94,19,1
  1021.    Ink 0,0 : Bar 521,26 To 521+94,26+20
  1022.    'Get 52 Blanks 
  1023.    For A=1 To 52
  1024.       Get Block A,36,4,CDXSZ,CDYSZ
  1025.    Next A
  1026.    'Lge Numbers Normal 60-85
  1027.    Restore NUMDATA : Y=190 : X=38
  1028.    N=60 : For A=1 To 26
  1029.       D=8 : If A=10 : D=15 : End If 
  1030.       If A=23 : D=15 : End If 
  1031.       Get Block N,X,Y,D,12,1
  1032.       Put Block N,MAKEAREAX+30,MAKEAREAY+30
  1033.       Read XX : Add X,XX
  1034.    Inc N : Next A
  1035.    'Lge Numbers Flipped 86-111
  1036.    Restore NUMDATA : Y=202 : X=270
  1037.    N=86 : For A=1 To 26
  1038.       D=8 : DD=0 : If A=10 : D=14 : DD=6 : End If 
  1039.       If A=23 : D=14 : DD=6 : End If 
  1040.       Get Block N,X-DD,Y,D,12,1
  1041.       Put Block N,MAKEAREAX+30,MAKEAREAY+30
  1042.       Read XX : Add X,-XX
  1043.    Inc N : Next A
  1044.    'Large Suits 112-119 
  1045.    N=112 : X=36 : Y=216
  1046.    For A=1 To 8
  1047.       D=0 : If A=3 or A=4 or A=7 or A=8 : D=1 : End If 
  1048.       Get Block N,X,Y,17+D,16,1
  1049.       Put Block N,MAKEAREAX+30,MAKEAREAY+30
  1050.       Add X,17
  1051.       If A=3 or A=4 or A=7 or A=8 : Add X,2 : End If 
  1052.    Inc N : Next A
  1053.    'Small Suits 120-127 
  1054.    N=120 : X=37 : Y=236
  1055.    For A=1 To 8
  1056.       Get Block N,X,Y,11,12,1
  1057.       Put Block N,MAKEAREAX+30,MAKEAREAY+30
  1058.       Add X,12
  1059.    Inc N : Next A
  1060.    ' Do Cards Red Numbers (1-26)
  1061.    N1=60 : N2=86 : For A=1 To 26
  1062.       S1=121 : S2=125 : If A>13 : S1=120 : S2=124 : End If 
  1063.       E=0 : DD=0 : D=0 : If A=10 or A=23 : D=6 : DD=2 : E=3 : End If 
  1064.       DDD=0 : If A>13 : DDD=1 : End If 
  1065.       Put Block A,MAKEAREAX,MAKEAREAY
  1066.       Put Block N1,MAKEAREAX+4,MAKEAREAY+1
  1067.       Put Block N2,MAKEAREAX+98-D,MAKEAREAY+76
  1068.       Put Block S1,MAKEAREAX+3+DD,MAKEAREAY+13+DDD
  1069.       Put Block S2,MAKEAREAX+96-D+E,MAKEAREAY+64+DDD
  1070.       Get Block A,MAKEAREAX,MAKEAREAY,CDXSZ,CDYSZ
  1071.       Inc N1 : Inc N2
  1072.       If N1>72 : N1=60 : N2=86 : End If 
  1073.    Next A
  1074.    ' Do Cards Black Numbers (27-52) 
  1075.    N1=73 : N2=99 : For A=27 To 52
  1076.       S1=122 : S2=126 : If A>39 : S1=123 : S2=127 : End If 
  1077.       E=0 : DD=0 : D=0 : If A=36 or A=49 : D=6 : DD=2 : E=3 : End If 
  1078.       DDD=0 : If A>13 : DDD=1 : End If 
  1079.       Put Block A,MAKEAREAX,MAKEAREAY
  1080.       Put Block N1,MAKEAREAX+4,MAKEAREAY+1
  1081.       Put Block N2,MAKEAREAX+98-D,MAKEAREAY+76
  1082.       Put Block S1,MAKEAREAX+3+DD,MAKEAREAY+12+DDD
  1083.       Put Block S2,MAKEAREAX+96-D+E,MAKEAREAY+64+DDD
  1084.       Get Block A,MAKEAREAX,MAKEAREAY,CDXSZ,CDYSZ
  1085.       Inc N1 : Inc N2
  1086.       If N1>85 : N1=73 : N2=99 : End If 
  1087.    Next A
  1088.    'Do all suits and pics 
  1089.    Restore SUITDATA
  1090.    S1=112 : S2=116 : C=0
  1091.    For A=1 To 52
  1092.       Put Block A,MAKEAREAX,MAKEAREAY
  1093.       If A=11 or A=24 or A=37 or A=50 : JACK : End If 
  1094.       If A=12 or A=25 or A=38 or A=51 : QUEEN : End If 
  1095.       If A=13 or A=26 or A=39 or A=52 : KING : End If 
  1096.       Read HM
  1097.       For S=1 To HM
  1098.          Read X,Y
  1099.          If Y<=40
  1100.             Put Block S1,X+1,Y
  1101.          End If 
  1102.          If Y>40
  1103.             Put Block S2,X+1,Y
  1104.          End If 
  1105.       Next S
  1106.       Get Block A,MAKEAREAX,MAKEAREAY,CDXSZ,CDYSZ
  1107.       Inc C
  1108.       If C>12
  1109.          C=0 : Restore SUITDATA
  1110.          Inc S1 : Inc S2
  1111.       End If 
  1112.    Next A
  1113.    If Fire(JY)=0 : REDBACK : End If 
  1114.    If Fire(JY)=-1 : BLUEBACK : End If 
  1115.    For A=60 To 127 : Del Block A : Next A
  1116. End Proc
  1117. Procedure DEMO
  1118.    Degree : X=0
  1119.    For A=1 To 52 : Y#=Sin(X) : Put Block A,X,Y#*50+100 : Add X,11 : Next A
  1120.    Add X,-11
  1121.    For A=52 To 1 Step -1 : Y#=Sin(X) : Put Block 53,X,Y#*50+100
  1122.    Add X,-11 : Next A : Radian : Cls 0
  1123. End Proc
  1124. NUMDATA:
  1125. Data 9,8,9,9,8,8,9,9,8,15,9,10,10
  1126. Data 9,8,9,9,8,9,8,9,9,15,8,10,10
  1127. SUITDATA:
  1128. Data 1,545,40
  1129. Data 2,545,8,545,72
  1130. Data 3,545,8,545,40,545,72
  1131. Data 4,518,8,572,8,518,72,572,72
  1132. Data 5,518,8,572,8,545,40,518,72,572,72
  1133. Data 6,518,8,572,8,518,40,572,40,518,72,572,72
  1134. Data 7,518,8,572,8,545,24,518,40,572,40,518,72,572,72
  1135. Data 8,518,8,572,8,545,24,518,40,572,40,545,56,518,72,572,72
  1136. Data 9,518,8,572,8,518,24,572,24,545,40,518,56,572,56,518,72,572,72
  1137. Data 10,518,8,572,8,545,24,518,24,572,24,518,56,572,56,545,56,518,72,572,72
  1138. Data 2,572,13,520,67
  1139. Data 2,574,13,518,67
  1140. Data 2,518,13,572,69
  1141. OPTIONDATA:
  1142. Data 11
  1143. Data "       Play Hand 1 ","  NO    ","  YES   "
  1144. Data "       Play Hand 2 ","  NO    ","  YES   "
  1145. Data "       Play Hand 3 ","  NO    ","  YES   "
  1146. Data "       Play Hand 4 ","  NO    ","  YES   "
  1147. Data "Change Player Name ","  NO    ","  YES   "
  1148. Data " Shuffle Each Hand ","  NO    ","  YES   "
  1149. Data "    Joystick Guide ","  On    ","  Off   "
  1150. Data "        Game Speed "," NORMAL "," TURBO  "
  1151. Data "Change No. Players ","  NO    ","  YES   "
  1152. Data "      SAVE Options ","  NO    ","  YES   "
  1153. Data "      Quit Options ","  NO    ","  YES   "
  1154. INSTDATA:
  1155. Data "PONTOON Istructions"
  1156. Data "-------------------"
  1157. Data "Please use FIRE for more instructions or UP AND FIRE to Quit!."
  1158. Data ""
  1159. Data "Welcome to this version of Pontoon which is very similar to normal Pontoon."
  1160. Data "There are some differences however, which will be explained below."
  1161. Data "For complete newcomers to Pontoon, here is a brief outline of the rules."
  1162. Data "The main deal is 2 cards. You then have a choice of TWIST/BUY or STICK."
  1163. Data "STICK means you do not want any more cards. TWIST means you want another"
  1164. Data "card, which will be dealt face up for everyone to see."
  1165. Data "BUY will deal you a card face down at a cost of ï¿½1O. NOTE: YOUR cards are"
  1166. Data "always dealt face up!. (SEE BELOW)"
  1167. Data "You can keep Twisting or Buying cards until you have a maximum of 5 cards"
  1168. Data "or until you are BUST. BUST means your cards add up to over 21 which is too"
  1169. Data "many!."
  1170. Data "An ACE has a value of 1 OR 11. Cards 2 to 1O are valued 2 to 1O."
  1171. Data "All picture cards, (Jack,Queen,King), are also valued at 1O."
  1172. Data "The winner of a hand, is the player with the highest value."
  1173. Data "The lowest you can STICK at is 15 and the highest is 21."
  1174. Data "A hand of 5 cards which has a total value of 21 or less is called A 5 Card"
  1175. Data "Trick and this beats 21, (NOTE: This is the ONLY instance where a value of"
  1176. Data "below 15 is allowed as a winning hand). This game WILL allow you to stick"
  1177. Data "below 15 at any time, but you CANNOT win unless you have a 5 card trick!."
  1178. Data "Any card with a value of 1O and an Ace is known as PONTOON and cannot be"
  1179. Data "beaten."
  1180. Data ""
  1181. Data "                    Game Instructions follow..."
  1182. Data ""
  1183. Data "The Following Instructions often refer to OPTIONS. This is selectable by"
  1184. Data "you at the end of a hand and allows many user changes to the game."
  1185. Data "You can play Any one hand or even all the hands from 1 to 4. If you"
  1186. Data "select to play no hands, the computer will play them all, (Auto mode)."
  1187. Data "Auto Mode can only be stopped at the end of a hand, so HOLD DOWN fire until"
  1188. Data "the Joystick Controls re-appear. In Options, players are numbered from"
  1189. Data "1 to 4. Player 1 is CHRIS,2 TOM,3 DICK,4 HARRY, although you can change any"
  1190. Data "of the above names. Player 1 is Dealt to first and also Bets. If he wins the"
  1191. Data "hand, he will be Dealt to first again and also Bet. If another player wins"
  1192. Data "the hand, it is their turn for the Bet etc. When 1 or more Players have the"
  1193. Data "same winning hand, they alone must Replay for the Pot and no further Bet is"
  1194. Data "made. NOTE: If YOU are not playing in a Replay, there is no need to use FIRE."
  1195. Data "The players will continue until one of them has won. This will also happen"
  1196. Data "when you are out of the game. The other players will continue alone although"
  1197. Data "this can be paused/stopped by holding down Fire before the end of a hand."
  1198. Data "If you have no cash left and all players Bust during a Replay, you will have"
  1199. Data "one more chance to play a hand with NO bet after the Pot Stays message."
  1200. Data "If all Players are Bust, the Pot stays, and another hand and Bet is played."
  1201. Data "This can result in a very large Pot for the winner. There is only one Bet"
  1202. Data "each hand. The minimum Bet is ï¿½5O and the maximum is your Cash or ï¿½2OO."
  1203. Data "You CANNOT Bet more than the Cash of the losing Player. This game can play in"
  1204. Data "either Normal or TURBO speed, TURBO should be used once you get used to it."
  1205. Data "SHUFFLE can be set on or off. If off, which is default, there will only be a"
  1206. Data "SHUFFLE before a New Game. The cards are always collected to the bottom of the"
  1207. Data "pack, so SHUFFLE off will allow them to come round again. SHUFFLE on, will"
  1208. Data "SHUFFLE after every hand. The number of players can be changed from 2,3 or 4."
  1209. Data "This will be delayed when a Replay is in progress etc. New players coming into"
  1210. Data "the game will have ï¿½5OO to start!. If you select New Game, the player with the"
  1211. Data "highest cash is the winner. This does NOT include you...."
  1212. Data "(NO cheating is permitted heh heh!). A card may be Bought at a cost of ï¿½1O"
  1213. Data "and is not seen by the rest of the players although ALL your cards are dealt"
  1214. Data "face up of course."
  1215. Data "The on screen joystick guide can be selected to off and will never be shown."
  1216. Data "Although it wont be displayed, Joystick UP will still bring up Options and"
  1217. Data "all other controls are as normal."
  1218. Data "Your oponents cards are sorted before their final show at the end of the hand."
  1219. Data "Your cards are sorted just after recieving a card as you will see."
  1220. Data "When Change Player Name is selected, you will be presented with each name in"
  1221. Data "turn. If you do not wish to change a name, press Fire and the next name will"
  1222. Data "be presented, (any name with less than 2 letters is ignored)."
  1223. Data "UP and DOWN will move from A-Z or Z-A. The _ character represents a space."
  1224. Data "LEFT and RIGHT moves along the name, and FIRE enters the name."
  1225. Data "The small Boxes at the bottom right of the screen are as follows..."
  1226. Data "The top one is the Pot. This shows the Pot of course."
  1227. Data "The second box displays the last person who made a bet."
  1228. Data "The third shows the last Bet made. It is also used when YOU make your own"
  1229. Data "bet."
  1230. Data "When New Game is requested and you use joystick UP to confirm it, holding"
  1231. Data "the fire button down as well, will change currency from ï¿½ to $ or $ to ï¿½"
  1232. Data "in the next game. Also after a New Game has been requested, the full pack"
  1233. Data "will be spread accross the screen before the shuffle. Holding down Fire"
  1234. Data "allows you to pause this and examine the Pack if required."
  1235. Data "At the start of the game, when the title is shown, holding down fire"
  1236. Data "until the game starts will result in Blue backed cards. Red is default."
  1237. Data "Selecting Save Options will save all your changes onto disk and will be used"
  1238. Data "in all future games...."
  1239. Data "Remember to use a COPY!, and to have the DISK WRITE PROTECT off!."
  1240. Data ""
  1241. Data "                                THE END"
  1242. Data ""
  1243. Data "                Please use Joystick UP/FIRE to continue"
  1244. Data "DONE"